let donnees = Ocsipersist.open_store "tarotv"

let ref_prochaine_partie =
  Ocsipersist.make_persistent
    ~store:donnees
    ~name:"prochaine_partie"
    ~default:0

let incr_parties () =
  Lwt.bind
    (ref_prochaine_partie)
    (fun reference ->
     Lwt.bind (Ocsipersist.get reference)
	      (fun i ->
	       Ocsipersist.set reference (i + 1)))

let prochaine_partie () =
  Lwt.bind
    (ref_prochaine_partie)
    (fun reference -> Ocsipersist.get reference)
  
let table = Ocsipersist.open_table "parties"

let archiver s noms =
  let tv = Array.map (Serveur.dump s) noms in
  if tv.(0).Tarotv.dp_gagnes <> 0 then
    let () = Printf.printf "Partie à archiver.\n%!" in
    let date = Unix.time () in
    let participants =
      String.concat ", " (Array.to_list noms) in
    let id = prochaine_partie () in
    let () = Lwt.async (incr_parties) in
    let nouvelle_partie = (date, participants, tv) in
    let () =
      Lwt.async
	(fun () ->
	 Lwt.bind
	   id
	   (fun id ->
	    let () = Printf.printf "Partie archivée : %d.\n%!" id in
	    Ocsipersist.add table (string_of_int id) nouvelle_partie)
	)
    in
    ()
  else
    let () = Printf.printf "Partie pas archivée.\n%!" in
    ()

let retrouver id_partie =
  let thread = Ocsipersist.find table (string_of_int id_partie) in
  Lwt.bind thread
	   (fun (_, _, etats) -> Lwt.return etats)

let est_inclus morceau chaine =
  let rec tester decalage i =
    if i + decalage < String.length chaine
       && i < String.length morceau
       && chaine.[i + decalage] = morceau.[i] then
      tester decalage (i + 1)
    else if i = String.length morceau then true
    else false
  in
  let rec aux decalage =
    if decalage + String.length morceau <= String.length chaine
       && tester decalage 0 then true
    else aux (decalage + 1)
  in
  aux 0

let contient chaine morceau = est_inclus morceau chaine

let sub_liste =
  let rec aux accumules i n = function
    | [] -> List.rev accumules
    | a :: b when i = 0 && n > 0 ->
       aux (a :: accumules) 0 (n - 1) b
    | a :: b when i = 0 -> List.rev accumules
    | a :: b ->
       aux accumules (i - 1) n b
  in
  aux []

let selectionner_resultats liste premier_element nombre_elements methode_tri =
  let comparer =
    match methode_tri with
    | `IdC ->
       fun (id1, _, _) (id2, _, _) ->
       Pervasives.compare (int_of_string id1) (int_of_string id2)
    | `IdD -> 
       fun (id1, _, _) (id2, _, _) ->
       Pervasives.compare (int_of_string id2) (int_of_string id1)
    | `DateC ->
       fun (_, date1, _) (_, date2, _) ->
       Pervasives.compare date1 date2
    | `DateD ->
       fun (_, date1, _) (_, date2, _) ->
       Pervasives.compare date2 date1
    | `ParticipantsC ->
       fun (_, _, p1) (_, _, p2) ->
       String.compare p1 p2
    | `ParticipantsD ->
       fun (_, _, p1) (_, _, p2) ->
       String.compare p2 p1
  in
  let liste_triee = List.sort (comparer) liste in
  sub_liste premier_element nombre_elements liste_triee
 
let chercher date_min date_max liste_participants premiere nombre_max tri =
  let resultats = ref [] in
  let contient_participants chaine =
    let presents = List.map (contient chaine) liste_participants in
    List.fold_left (&&) true presents
  in
  let examiner id (date, participants, _) =
    let () =
      if date >= date_min && date < date_max
	 && contient_participants participants
      then resultats := (id, date, participants) :: !resultats
      else ()
    in
    Lwt.return ()
  in
  let fin = Ocsipersist.iter_table (examiner) table in
  Lwt.bind
    fin
    (fun () ->
     Lwt.return (selectionner_resultats !resultats premiere nombre_max tri,
		 List.length !resultats))
